Unfallstatistik Regensburg

Konstantin Schneider

2021-09-26

Index

Aufgabe

Ein Datenprojekt Ihrer Wahl. Dies muss nicht in R realisiert sein, kann mit einem Werkzeug Ihrer Wahl entstehen.
Ziel: Text und überzeugende Darstellung der Ergebnisse.

1 Unfalldaten

Das Statistische Bundeamt stellt eine vielzahl an unterschiedlichen Datensätzen zur Verfügung. In diesem Dokument werden offizielle Unfalldaten mit Personenschaden für Regensburg ausgewertet. Diese können hier heruntergeladen werden.

library(tidyverse)
library(lubridate)
filenames <-
  list.files(
    path = here::here("data-raw/accidents")
  )
ReadGarbageData <- function(filename){

  # read a file
  data <- read_csv2(here::here("data-raw/accidents", filename))

  # the files have different headers
  # this key corrects that
  col_key <-
    c(
      # ids
      FID = "id1",
      OBJECTID = "id2",
      OBJECTID_1 = "id2",
      UIDENTSTLA = "id3",
      UIDENTSTLAE = "id3",
      # lighting
      ULICHTVERH = "light_condition",
      LICHT = "light_condition",
      # street condition
      IstStrasse = "street_condition",
      STRZUSTAND = "street_condition",
      # other
      IstSonstig = "other",
      IstSonstige = "other",
      # common
      ULAND = "land",
      UREGBEZ = "bezirk",
      UKREIS = "kreis",
      UGEMEINDE = "gemeinde",
      UJAHR = "year",
      UMONAT = "month",
      USTUNDE = "hour",
      UWOCHENTAG = "weekday",
      UKATEGORIE = "severity",
      UART = "kind_of_accident",
      UTYP1 = "type_of_accident",
      IstRad = "bicycle",
      IstKrad = "bike",
      IstPKW = "car",
      IstFuss = "pedestrian",
      IstGkfz = "truck",
      LINREFX = "linref_x",
      LINREFY = "linref_y",
      XGCSWGS84 = "lng",
      YGCSWGS84 = "lat"
    )

  # correct col names via the key
  names(data) <- col_key[names(data)]

  # correct col types
  data <-
    data |>
    mutate(
      bezirk = as.character(bezirk),
      year = as.numeric(year),
      month = as.numeric(month),
      hour = as.numeric(hour)
    )

  return(data)
}
data <-
  filenames |>
  map_dfr(
    ReadGarbageData
  ) |>
  select(-starts_with("id"))
data <-
  data |>
  filter(
    land == "09" &
    bezirk == "3" &
    kreis == "62" &
    gemeinde == "000"
  ) |>
  select(-kind_of_accident, -type_of_accident, -linref_x, -linref_y) |>
  select(-land, -bezirk, -kreis, -gemeinde)

# add id
data <-
  data |>
  mutate(
    id = row_number()
  ) |>
  select(id, everything())
data <-
  data |>
  mutate(
    datetime = glue::glue("{month}-{year}-{hour}") |>
      parse_datetime(format = "%m-%Y-%H")
  ) |>
  mutate(
    weekday = wday(weekday, label = TRUE),
    date = date(datetime)
  ) |>
  mutate(
    across(
      .cols = c(severity, light_condition, street_condition),
      .fns = as_factor
    )
  ) |>
  mutate(
    across(
      .cols = bicycle:other,
      .fns = as.logical
    )
  ) |>
  mutate(
    severity = fct_recode(
      severity,
      "Toedlich" = "1",
      "Schwer" = "2",
      "Leicht" = "3"
    ),
    light_condition = fct_recode(
      light_condition,
      "Tageslicht" = "0",
      "Dämmerung" = "1",
      "Dunkelheit" = "2"
    ),
    street_condition = fct_recode(
      street_condition,
      "Trocken" = "0",
      "Nass/Feucht" = "1",
      "Winterglatt" = "2"
    )
  )
data |> 
  DT::datatable()

1.1 Geocode

# pb <- 
#   progress::progress_bar$new(
#     format = "Lade Geodaten :current/:total [:bar] :percent (eta: :eta)",
#     total = nrow(data)
#   )
# 
# pb$tick(0)
# 
# data <- 
#   map2_dfr(
#     .x = data$lng,
#     .y = data$lat,
#     .f = function(x = .x, y = .y){
#       
#       geodata <- photon::reverse(x, y) |> 
#         select(name:country)
#       
#       pb$tick()
#       
#       return(geodata)
#     }
#   ) |>
#   mutate(
#     id = row_number(),
#     street = ifelse(is.na(street), name, street)
#   ) |>
#   right_join(data, by = c("id"))
# 
# remove(pb)

1.2 CSV/RDA speichern.

# data
write_csv2(
  x = data,
  file = here::here("output/regensburg_data.csv")
)

save(
  list = c("data"),
  file = here::here("data/regensburg_data.rda")
)

2 Shapefiles

library(tidyverse)
library(sf)

Die restlichen Shapefiles (Stadtgrenze, Stadtteile, Gewässer, Autobahnen) stammen vom Amt für Stadtentwicklung Regensburg

2.1 Stadtgrenze Regensburg

sf.regensburg <- 
  read_sf(here::here("data-raw/shapefiles/regensburg/gesamtstadt.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "m2" = qm
  ) |>
  select(m2, geometry)
ggplot() +
  geom_sf(data = sf.regensburg) +
  ggthemes::theme_map()

2.2 Stadtteile

sf.districts <- 
  read_sf(here::here("data-raw/shapefiles/districts/stadtbezirke.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "district" = Name,
    "ha" = Hektar
  ) |> 
  mutate(
    m2 = ha * 10^4
  ) |> 
  select(district, m2, geometry)
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.3 Autobahnen

sf.highways <- 
  read_sf(here::here("data-raw/shapefiles/highways/autobahn.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "feeder" = ZUBRINGER
  ) |> 
  mutate(
    feeder = case_when(
      feeder == "j" ~ TRUE,
      feeder == "n" ~ FALSE
    )
  )
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.highways, alpha = 0.6) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.4 Flüsse

sf.rivers <- 
  read_sf(here::here("data-raw/shapefiles/rivers/gewaesser.shp")) |> 
  st_transform("WGS84") |> 
  select(geometry)
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.rivers, alpha = 0.6) +
  geom_sf(data = sf.highways, alpha = 0.6) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.5 Finale Karte

ggplot() +
  geom_sf(data = sf.districts, aes(fill = district), alpha = 0.7) +
  geom_sf(data = sf.rivers, alpha = 0.7, fill = "lightblue") +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  theme_void() +
  theme(
    legend.position = "right",
    legend.title = element_blank()
  )

3 Leaflet Karte

library(tidyverse)
library(leaflet)
library(sf)
load(
  here::here("data/regensburg_data.rda")
)

load(
  here::here("data/shapefiles.rda")
)
sf.data <-
  data |> 
  st_as_sf(coords = c("lng", "lat"), crs = "WGS84")

3.1 Basemap

bounds <- sf.regensburg |> st_bbox()

map <- 
  leaflet(
    options = leafletOptions(
      crs = leafletCRS(code = "WGS84"),
      preferCanvas = NULL
    )
  ) |> 
  addProviderTiles(
    provider = providers$OpenStreetMap.DE,
    group = "OSM",
    options = providerTileOptions(minZoom = 11)
  ) |> 
  setView(
    lng = (as.numeric(bounds[1]) + as.numeric(bounds[3]))/2,
    lat = (as.numeric(bounds[2]) + as.numeric(bounds[4]))/2,
    zoom = 12
  ) |> 
  setMaxBounds(
    lng1 = as.numeric(bounds[1] - 0.015), 
    lat1 = as.numeric(bounds[2] - 0.015), 
    lng2 = as.numeric(bounds[3] + 0.015), 
    lat2 = as.numeric(bounds[4] + 0.015)
  )

3.2 Marker

custom_popup <- function(data, header) {
  text <- 
    glue::glue(
      "<b>{header}</b> ",
      "<br>",
      "{data$month}/{data$year} ({data$hour} Uhr)"
    )
  return(text)
}
map <- 
  map |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Toedlich"),
    group = "Tödliche Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "red"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Toedlich"), 
      header = "Tödlicher Unfall"
    )
  ) |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Schwer"),
    group = "Schwere Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "orange"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Schwer"), 
      header = "Schwerer Unfall"
    )
  ) |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Leicht"),
    group = "Leichte Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "beige"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Leicht"), 
      header = "Leichter Unfall"
    )
  )

3.3 Stadtteile als Shapefile

custom_label <- function(data) {
  text <- glue::glue(
    "{data$district}: {data$n} Unfälle"
  )
  return(text)
}
districts <-
  data |> 
  st_as_sf(coords = c("lng", "lat"), crs = "WGS84") |> 
  rename(
    points = geometry
  ) |> 
  st_join(
    y = sf.districts |> rename("district_shape" = geometry),
    join = st_within,
    left = TRUE
  ) |> 
  select(-m2) |> 
  as_tibble() |> 
  left_join(
    y = sf.districts |> rename("district_polygon" = geometry) ,
    by = "district"
  ) |>
  drop_na(district) |>
  mutate(
    district = as_factor(district) |>
      fct_infreq() |>
      fct_rev()
  ) |> 
  add_count(district) |> 
  select(district, district_polygon, n) |> 
  unique() |> 
  st_as_sf()
map <-
  map |> 
  addPolygons(
    data = districts,
    group = "Stadtteile",
    opacity = 1,
    weight = 0.5, 
    fillOpacity = 0.5,
    color = "black",
    fillColor = ~colorNumeric("viridis", n)(n),
    highlightOptions = highlightOptions(
      color = "white", 
      weight = 2,
      bringToFront = TRUE
    ),
    label = ~custom_label(data = districts)
  )

3.4 Bedienelemente

map <- 
  map |> 
    addProviderTiles(
      provider = providers$Stamen.TonerBackground,
      group = "Stadtteile",
      options = providerTileOptions(minZoom = 11)
    ) |> 
    addLayersControl(
      baseGroups = c("OSM", "Stadtteile"),
      overlayGroups = c("Tödliche Unfälle", "Schwere Unfälle", "Leichte Unfälle"),
      options = layersControlOptions(collapsed = FALSE)
    )

3.5 Finale Karte

map

4 Auswertung

Zur besseren Lesbarkeit wird der R Code in diesem Kapitel nicht gezeigt. Dieser besteht größtenteils aus Plots und ist bis auf wenige Ausnahmen nicht weiter relevant.

Im Stadtgebiet Regensburg geschahen von den Jahren 2016 bis 2020 insgesamt 3167 Unfälle mit Personenschaden. Abbildung 4.1 zeigt die monatlichen Unfälle in diesem Zeitraum.

Monatliche Unfälle in Regensburg.

Abbildung 4.1: Monatliche Unfälle in Regensburg.

Während sich kein eindeutiger Auf- oder Abwärtstrend feststellen lässt, zeigen die Daten dennoch eine Jährliche Periodizität: Im Sommer finden die meisten Unfälle mit Personenschaden statt, während die Anzahl der Unfälle von Herbst bis Frühjahr sinkt.

Abbildung 4.2 zeigt die Anzahl der jährlichen Unfälle in Regensburg. Im Jahr 2020 zeigt sich ein Rückgang von 25%. Dieser kann auf geringeren Verkehr aufgrund der Corona Pandemie zurückgeführt werden. Dies wird durch Abbildung 4.3 verdeutlicht: Alle dokumentierten Verkehrsmittel hatten einen Rückgang der jährlichen Unfälle von 2019 bis 2020.

Jährliche Unfälle mit Personenschaden.

Abbildung 4.2: Jährliche Unfälle mit Personenschaden.

Abbildung 4.3 zeigt zudem, dass sich die Anzahl der Unfälle aller Verkehrsmittel außer Fahrrad auf einem fallenden Trend befinden. Die Anzahl der Unfälle mit Fahrradbeteiligung dagegen stieg bis 2020 kontinuierlich an.

Jährliche Unfälle mit Personenschaden nach Verkehrsteilnehmer unterteilt.

Abbildung 4.3: Jährliche Unfälle mit Personenschaden nach Verkehrsteilnehmer unterteilt.

4.1 Unfälle nach Monat

4.2 Unfälle nach Uhrzeit

4.3 Unfälle nach Ortsteil

4.3.1 Absolute Anzahl

4.3.2 Pro Quadratkilometer

5 Unfallteilnehmer

load(
  here::here("data/regensburg_data.rda")
)

Fragen:

  • Tödliche/Schwere Unfälle mit Fußgängern? Motorrad?
  • Mehr Fußgängerunfälle in der Innenstadt?
data.vehicle <- 
  data |> 
  pivot_longer(
    cols = bicycle:truck,
    names_to = "type_of_vehicle",
    values_to = "took_part"
  ) |> 
  drop_na() |> 
  count(type_of_vehicle, took_part, severity)

data.vehicle |> knitr::kable()
type_of_vehicle took_part severity n
bicycle FALSE Toedlich 4
bicycle FALSE Schwer 204
bicycle FALSE Leicht 1627
bicycle TRUE Toedlich 2
bicycle TRUE Schwer 189
bicycle TRUE Leicht 1141
bike FALSE Toedlich 3
bike FALSE Schwer 324
bike FALSE Leicht 2440
bike TRUE Toedlich 3
bike TRUE Schwer 69
bike TRUE Leicht 328
car FALSE Toedlich 2
car FALSE Schwer 137
car FALSE Leicht 651
car TRUE Toedlich 4
car TRUE Schwer 256
car TRUE Leicht 2117
pedestrian FALSE Toedlich 6
pedestrian FALSE Schwer 336
pedestrian FALSE Leicht 2538
pedestrian TRUE Schwer 57
pedestrian TRUE Leicht 230
truck FALSE Toedlich 5
truck FALSE Schwer 275
truck FALSE Leicht 2129
truck TRUE Toedlich 1
truck TRUE Schwer 18
truck TRUE Leicht 96

Pakete

Cheng, Joe, Bhaskar Karambelkar, and Yihui Xie. Leaflet: Create Interactive Web Maps with the JavaScript Leaflet Library, 2021. https://rstudio.github.io/leaflet/.
Grolemund, Garrett, and Hadley Wickham. “Dates and Times Made Easy with lubridate.” Journal of Statistical Software 40, no. 3 (2011): 1–25. https://www.jstatsoft.org/v40/i03/.
Pebesma, Edzer. Sf: Simple Features for r, 2021. https://CRAN.R-project.org/package=sf.
———. Simple Features for R: Standardized Support for Spatial Vector Data.” The R Journal 10, no. 1 (2018): 439–46. https://doi.org/10.32614/RJ-2018-009.
Spinu, Vitalie, Garrett Grolemund, and Hadley Wickham. Lubridate: Make Dealing with Dates a Little Easier, 2021. https://CRAN.R-project.org/package=lubridate.
Wickham, Hadley. Tidyverse: Easily Install and Load the Tidyverse, 2021. https://CRAN.R-project.org/package=tidyverse.
Wickham, Hadley, Mara Averick, Jennifer Bryan, Winston Chang, Lucy D’Agostino McGowan, Romain François, Garrett Grolemund, et al. “Welcome to the tidyverse.” Journal of Open Source Software 4, no. 43 (2019): 1686. https://doi.org/10.21105/joss.01686.